00100	C THIS AIDS IN EXTRACTING PARTS FROM SCORES - OR PACKING OF .DAT
00200	C   FILES FOR EASIER STORAGE.   
00300	      DIMENSION XN(2000),RSTFAC(8),IV(78),LIST(200),PWDS(250),RN(2000)
00400		1,XWDS(250),STFF(8),NLIST(200),NX(200)
00500	C**** RN MIGHT HAVE TO BE 4000 ******
00600		EQUIVALENCE (XN,NX)
00700	
00800		JR=0
00900	72	TYPE 71
01000		ACCEPT 2,N
01100		IF(N.NE.'HELP')GO TO 73
01200		TYPE 14
01300		GO TO 72
01400	73	IF(N.NE.'PARTS')GO TO 211
01500	71	FORMAT(' TYPE "MTA", "PARTS", "PACK" OR "UNPACK"  ',$)
01600		REWIND 1
01700	14	FORMAT(' FOR "READ WHICH STAFF#?"  GIVE N1, N2, N3'/'
01800		1 N2=TRANSP. STEPS,  N3=1=WILL BE SAME FOR ALL FILES'/)
01900		TYPE 1
02000		ACCEPT 2,NAME
02100	13	CALL OFILE(1,NAME)
02200		XWDS(1)=1
02300		RM=0
02400		L=1
02500		LP=1
02600		TYPE 44
02700		ACCEPT 5,RS
02800	10	TYPE 3
02900		LK=LP
03000		ACCEPT 2,NAME
03100		IF(NAME.EQ.' ')GO TO 20
03200		JZ=0
03300		IF(RM.NE.0)GO TO 77
03400		TYPE 4
03500		ACCEPT 5,SN,TR,RM
03600		GO TO 77
03700	C TYPE 2ND NUM FOR TRANSPOSE, 3RD NUM FOR ALWAYS SAME STFF.
03800	8	DO 6 K=1,ITEM
03900		J=PWDS(K)
04000		IF(RN(J+1).NE.4)GO TO 80
04100		IF(RN(J).NE.2)GO TO 80
04200	C  FOUND A BAR LINE
04300		RN(J+4)=1
04400		GO TO 81
04500	80	IF(RN(J+3).NE.SN)GO TO 6
04600		JZ=-1
04700	81	JA=PWDS(K+1)
04800		DO 7 KA=J,JA-1
04900		XN(LK)=RN(KA)
05000	7	LK=LK+1
05100		IF(L.LT.250.AND.LK.LE.2000)GO TO 50
05200		TYPE 9
05300		GO TO 20
05400	16	FORMAT(' STAFF NOT FOUND'/)
05500	50	R=XN(LP+1)
05600		IF(TR.NE.0.AND.(R.EQ.1.OR.R.EQ.8.OR.R.EQ.9))GO TO 52
05700	51	XN(LP+3)=RS
05800		L=L+1
05900		LP=LK
06000		XWDS(L)=LP
06100	6	CONTINUE
06200		IF(JZ)GO TO 17
06300		L=JX
06400		LP=JY
06500		TYPE 16
06600		GO TO 10
06700	17	JX=L
06800		JY=LP
06900		RS=RS-1
07000		IF(RS.GT.-4)GO TO 10
07100	20	L=JX-1
07200		J=1
07300		WRITE(1),L,JY,
07400		1 (XWDS(K),K=1,L+1),(XN(K),K=1,JY-1),J,J,J,J
07500	15	END FILE 1
07600		CALL EXIT
07700	1	FORMAT(' TYPE OUTPUT FILE NAME  ',$)
07800	2	FORMAT(A5)
07900	3	FORMAT(' TYPE FILE NAME  ',$)
08000	4	FORMAT(' READ WHICH STAFF # ?  ',$)
08100	5	FORMAT(5F)
08200	9	FORMAT(' NO ROOM FOR THIS ONE')
08300	44	FORMAT(' TYPE TOP STAFF #  ',$)
08400	
08500	C TO PACK AND UNPACK FILES FOR MSS PRINTING PROG.(FOR STORAGE ONLY)
08600	211	IF(N.EQ.'MTA')GO TO 200
08700		IF(N.EQ.'UNPAC')GO TO 311
08800		TYPE 1
08900		ACCEPT 2,ONAME
09000		REWIND 1
09100		CALL OFILE (1,ONAME)
09200	411	TYPE 511
09300	511	FORMAT(' TYPE FILE NAME OR X(=EXIT)  ',$)
09400		ACCEPT 2,NAME
09500		IF(NAME.EQ.'X'.OR.NAME.EQ.' ')GO TO 811
09600	77	REWIND 21
09700	177	CALL IFILE(21,NAME)
09750	2202	IF(N.EQ.'UNPAC')GO TO 3202
09800		READ(21),ITEM,I,
09900		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
10000		1 LCNT,(LIST(K),K=1,LCNT)
10100		IF(I.NE.0)GO TO 91
10200		TYPE 92
10300		CALL EXIT
10400	92	FORMAT(' **** UNPACK IT FIRST ****')
10500	91	IF(N.EQ.'PARTS')GO TO 8
10600		READ(21)RSTFAC,STFF
10700		IF(JR)GO TO 217
10800		IF(N.EQ.'UNPAC')GO TO 74
10900	
11000		WRITE (1),NAME
11010		WRITE(1),ITEM,I,
11040		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
11070		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF,K
11085		GO TO 411
11100	911	WRITE(1),ITEM,I,
11200		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
11300		1 LCNT,(LIST(K),K=1,LCNT),K
11400		WRITE(1),RSTFAC,STFF,IBOT,ITOP,K
11500	C***** K IS BECAUSE OF FORTRAN WRITE BUG!!!!!!
11600	CC	IF(N.EQ.'PACK')GO TO 411
11700	811	END FILE 1
11800		IF(N.EQ.'PACK')CALL EXIT
11900		IF(JR)GO TO 216
12000		GO TO 79
12010	3202	READ(21)ITEM,I,(PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,
12020		1 (IV(K),K=1,ISCR),LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
12030		GO TO 74
12100	
12200	200	TYPE 201
12300		REWIND 16
12400		ACCEPT 111,L
12500		IF(L.EQ.'W')GO TO 202
12600	1200	CALL IFILE(16,N)
12700		READ(16)NLIST
12800		IF(L.EQ.'W')GO TO 202
12900		DO 204 KX=1,200
13000		IF(NLIST(KX).EQ.' ')GO TO 205
13100		IF(MOD(KX,16).EQ.0)PAUSE
13200	204	TYPE 112,KX,NLIST(KX)
13300	205	M=1
13400		L=1
13500	209	TYPE 206
13600		ACCEPT 2,NX(M)
13700		REREAD 207,J,N
13800	CZ	IF(N.NE.0)GO TO 208
13900		IF(NX(M).EQ.' ')GO TO 210
14000		M=M+1
14100		GO TO 209
14200	210	J=1
14300	216	IF(NX(J).EQ.' ')GO TO 219
14400		DO 212 KX=L,200
14500		READ(16),NJ,ITEM,I,PWDS,RN,ISCR,IV,LCNT,LIST,
14600		1 RSTFAC,STFF,IBOT,ITOP
14700	212	IF(NJ.EQ.NX(J))GO TO 218
14800	218	NAME=NJ
14900		J=J+1
15000		L=KX+1
15100		GO TO 179
15200	220	FORMAT(' NEW TAPE OR OLD?  ',$)
15300	
15400	202	TYPE 220
15500		ACCEPT 111,LX
15600		IF(LX.EQ.'O')GO TO 1200
15700		CALL OFILE(16,N)
15900		JR=-1
16000		N=0
16100	214	N=N+1
16110		TYPE 3
16200		ACCEPT 203,NLIST(N)
16300		IF(NLIST(N).NE.' ')GO TO 214
16400	213	WRITE(16),NLIST
16500		M=1
16600	215	NAME=NLIST(M)
16700		GO TO 177
16800	217	WRITE(16),NAME,ITEM,I,PWDS,RN,ISCR,IV,LCNT,LIST,
16900		1 RSTFAC,STFF,IBOT,ITOP,K
17000		TYPE 111,K,NAME
17100		M=M+1
17200		IF(M.NE.N)GO TO 215
17300	219	REWIND 16
17400		CALL EXIT
17500	201	FORMAT(' READ OR WRITE?  ',$/)
17600	203	FORMAT(200A5)
17700	206	FORMAT(' TYPE FILE NAME OR NUMS.  ',$)
17800	112	FORMAT(I4,2XA5)
17900	207	FORMAT(2I)
18000	311	TYPE 511
18100		ACCEPT 2,NAME
18200		IF(NAME.EQ.'X'.OR.NAME.EQ.' ')CALL EXIT
18300		CALL IFILE(21,NAME)
18400	79	READ (21,END=75),NAME
18500		GO TO 2202
18600	74	K=' '
18700		TYPE 111,K,NAME
18800		TYPE 76
18900		ACCEPT 2,K
19000		IF(K.EQ.'PASS'.OR.K.EQ.'P')GO TO 79
19100		IF(K.EQ.'X')CALL EXIT
19200		IF(K.NE.' ')NAME=K
19300	179	CALL OFILE(1,NAME)
19400		GO TO 911
19500	75	CALL EXIT
19600	76	FORMAT(' TYPE <CR>, <PASS> OR NEW NAME.  X=EXIT  ',$)
19700	111	FORMAT(A1,A5)
19800	
19900	52	A=XN(LP+4)
20000		XN(LP+4)=A+TR
20100	C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
20200		X=XN(LP+5)
20300		IF(XN(LP+1).EQ.1)GO TO 11
20400		XN(LP+5)=X+TR
20500		GO TO 51
20600	11	IF(TR.EQ.4.AND.AMOD(A,7.0).EQ.0)GO TO 101
20700		IF(AMOD(TR-1.0,7.0).NE.0)GO TO 51
20800	C  NEXT IS FOR Bb TRANSP.
20900		B=AMOD(A+7.0,7.0)
21000		IF(B.NE.0.AND.B.NE.3)GO TO 51
21100	C  FINDS ORIG. E OR B
21200	101	M=AMOD(X,10.0)
21300	C  FINDS ACCID.
21400		X=X-M
21500	C  STEM DIR. AND DECI.
21600		B=3.
21700	C CHANGES FLAT TO NATURAL SIGN.
21800		IF(M.EQ.0.OR.M.EQ.3)B=2
21900	C  NO PROVISION YET FOR ## OR bb
22000		XN(LP+5)=X+B
22100		GO TO 51
22200		END